SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00023 DISK DRIVE HANDLING ROUTINES 1 05-28-9313:38ALL SWAG SUPPORT TEAM CDROM.PAS IMPORT 124 {π> Are there anybody out there who has some routins to play CD Audio in a CDπ> ROM drive. Just the usual commands like play, stop, resume, eject and soπ> on. I would appreciate any help!π}ππUnit CDROM;ππ{ Unit talking to a CD-Rom-Driveπ Low-level CD access,π only the first drive is supported...!π Copyright 1992 Norbert Igl }ππInterfaceππTypeπ CD_Record = Recordπ Status : Word; { Status des Drives/letzte Funktion }π DrvChar: Char; { LW-Buchstabe }π DrvNo : Byte; { als Byte ablegegt (0...) }π HSG_RB : Byte; { Adressierungs-Modus }ππ Sector : LongInt; { Adresse des Lesekopfes }π VolInfo: Array[1..8] of Byte; { Lautst.-Einstellungen }π DevPar : LongInt; { Device-parameter, BIT-Feld! }π RawMode: Boolean; { Raw/Cooked-Mode ? }π SecSize: Word; { Bytes/Sector }π VolSize: LongInt; { sek/Volume => Groesse der CD}ππ MedChg : Byte; { Disk gewechselt? }ππ LoAuTr : Byte; { kleinste Audio-Track # }π HiAuTr : Byte; { groesste Audio-Track # }π endAdr : LongInt; { Adresse der Auslaufrille (8-) }ππ TrkNo : Byte; { Track #. Eingabe-Wert ! }π TrkAdr : LongInt; { Adresse dieses Tracks }π TrkInf : Byte; { Info dazu: BIT-Feld! }ππ CntAdr : Byte; { CONTROL und ADR, von LW }π CTrk : Byte; { track # }π Cindx : Byte; { point/index }π CMin : Byte; { minute\ }π CSek : Byte; { second > Laufzeit im Track }π CFrm : Byte; { frame / }π Czero : Byte; { immer =0 }π CAmin : Byte; { minute \ }π CAsec : Byte; { sekunde > Laufzeit auf Disk }π CAFrm : Byte; { frame / }ππ Qfrm : LongInt;{ start-frame address }π Qtrfs : LongInt;{ Bufferaddresse }π Qcnt : LongInt;{ Anzahl der Sectoren }π { pro Sector werden 96 Byte nach buffer kopiert }ππ Uctrl : Byte; { CONTROL und ADR Byte }π Upn : Array[1..7] of Byte; { EAN-CODE }π Uzero : Byte; { immer = 0 }π Ufrm : Byte; { Frame-# }π end;π OneTrack = Recordπ Title : String[20];π Runmin,π RunSec : Byte;π Start : LongInt; { HSG Format ! }π end;π VolumeTableOfContens = Recordπ Diskname: String[20];π UAN_Code: String[13];π TrackCnt: Byte;π Titles : Array[1..99] of OneTrack;π end;π TrkInfo = Recordπ Nummer : Byte;π Start : LongInt;π Cntrl2 : Byte;π end;π{===== global verfuegbare Variablen =============}ππVar CD : CD_Record;π CD_AVAIL : Boolean;π VtoC : VolumeTableOfContens;π CD_REDPos : String;π CD_HSGPos : String;ππ{===== allgemeine Funktionen ===================}ππFunction CD_Reset : Boolean;πFunction CD_HeadAdr : Boolean;πFunction CD_Position: Boolean;πFunction CD_MediaChanged: Boolean;πππ{===== Tray/Caddy-Funktionen ===================}ππFunction CD_Open: Boolean;πFunction CD_Close: Boolean;πFunction CD_Eject: Boolean;ππ{==== Audio-Funktionen =========================}ππFunction CD_Play(no:Byte; len:Integer): Boolean;πFunction CD_Stop: Boolean;πFunction CD_Resume:Boolean;πFunction CD_SetVol:Boolean;πFunction CD_GetVol:Boolean;ππProcedure CD_Info;πProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );ππ{==== Umwandlungen =============================}ππFunction Red2Time( Var Inf:TrkInfo ):Word;ππImplementation Uses Dos;πType IOCtlBlk = Array[0..200] of Byte;ππConst IOCtlRead = $4402;π IOCtlWrite = $4403;π DevDrvReq = $1510;π All:LongInt= $0f00;ππVar R : Registers;π H : Text;π Handle : Word;π Old_Exit : Pointer;π CtlBlk : IOCtlBlk;ππ Tracks : Array[1..100] of TrkInfo;ππProcedure CD_Exit; { wird bei Programmende ausgefuehrt }πbeginπ if Old_Exit <> NILπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction CD_Init: Boolean; { Initialisierung beim Programmstart }πbeginπ FillChar( CD, SizeOf( CD ), 0);π With R doπ beginπ AX := $1500;π BX := $0000;π CX := $0000;π Intr( $2F, R );π CD_Init := (BX > 0); { Anzahl der CD-Laufwerke }π If BX > 0π then beginπ CD.DrvChar { CD-Laufwerksbuchstabe }π := Char( CL + Byte('A') );π CD.DrvNo := CL;π If CD_HeadAdr thenπ If CD_GetVol then;π endπ else CD.DrvChar := '?'; { im Fehlerfall...}π endπend;ππProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );πbeginπ T := Tracks[nr]πend;ππFunction OpenCDHandle:Word;πConst Name : String[8] = 'MSCD001'; { evt. anpassen!!! ? }πbeginπ Assign(H, Name); { Filehandle holen }π(*$I-*)π Reset(H);π(*$I+*)π if IoResult = 0 thenπ beginπ Handle := TextRec(H).Handle; { Filehandle holen }π Old_Exit := ExitProc; { Bei ende/Abbruch muss 'H'... }π ExitProc := @CD_Exit; { ...automatisch geschlossen werden }π endπ else Handle := 0;π OpenCDHandle := Handle;πend;ππProcedure CloseCDHandle;πbeginπ if TextRec(H).Mode <> FmClosedπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π Old_Exit := NIL;π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction Red2HSG( Var Inf:TrkInfo ):LongInt;πVar l: LongInt;πbeginπ l := LongInt(( Inf.Start shr 16 ) and $FF ) * 4500;π l := l + LongInt(( Inf.Start shr 8 ) and $FF ) * 75;π l := l + LongInt(( Inf.Start ) and $FF ) ;ππ Red2HSG := l -2;πend;ππFunction Red2Time( Var Inf:TrkInfo ):Word;πbeginπ Red2Time:= (( Inf.Start shr 24 ) and $FF ) shl 8π + (( Inf.Start shr 16 ) and $FF )πend;ππFunction HSG2Red(L:LongInt):LongInt;πbeginπend;ππFunction CD_IOCtl( Func, Len : Word) : Boolean;πbeginπ With R doπ beginπ AX := Func;π BX := OpenCDHandle;π CX := 129;π DS := DSeg;π ES := DS;π DX := Ofs(CtlBlk);π MsDos( R );π CD.Status := AX;π CD_IOCtl := (Flags and FCARRY) = 0;π CloseCDHandle;π endπend;πππFunction CD_Reset: Boolean;πbeginπ CtlBlk[0] := 2; { Reset }π CD_Reset := CD_IoCtl( IoCtlWrite, 1)πend;ππFunction DieTuer( AufZu:Byte ): Boolean;πbeginπ CtlBlk[0] := 1; { die Tuer.. }π CtlBlk[1] := AufZu; { ..freigeben }π DieTuer := CD_IoCTL(IoCtlWrite, 2);πend;ππFunction CD_Open: Boolean;πConst Auf = 0;πbeginπ CD_Open := DieTuer( Auf );πend;ππFunction CD_Close: Boolean;πConst Zu = 1;πbeginπ CD_Close := DieTuer( Zu );πend;πππFunction CD_Eject: Boolean;πbeginπ CtlBlk[0] := 0; { CD auswerfen }π CD_Eject := CD_IOCtl(IoCtlWrite, 1);πend;πππFunction CD_Play(no:Byte; len:Integer): Boolean;πbegin { CD PlayAudio }ππ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 22; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $84; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π CtlBlk[13]:= CD.HSG_RB; { HSG-Modus }ππ CD.Sector := VtoC.Titles[no].Start; { ist im HSG-Format }ππ Move( CD.Sector, CtlBlk[14], 4 ); { Start-Sector }π if len = -1π then All := $FFFFπ else All := len;π Move( All , CtlBlk[18], 4 ); { Anzahl Sectoren}π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Play := CD.Status and $8000 = 0;ππend;ππFunction CD_VtoC:Boolean;πVar i: Byte;π l: LongInt;πbeginπ FillChar( Tracks, SizeOf( Tracks ), 0);π CtlBlk[0] := 10; { Read LeadOut-Tr }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], CD.LoAuTr, 6);π i := CD.HiAuTr+1;π Move( CtlBlk[3], Tracks[i], 4); { die Auslaufrille 8-) }π Tracks[i].Start := Red2Hsg(Tracks[i]);ππ For i := CD.LoAuTr to CD.HiAuTr doπ beginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0); { RED-Book-Format }π CtlBlk[0] := 11; { Read VtoC-Entry }π CtlBlk[1] := i; { track-no }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], Tracks[i], 6);π{ Tracks[i].Start := Red2Hsg(Tracks[i]); }π end;πππ With VtoC doπ beginπ DiskName := '';π UAN_Code := '';π TrackCnt := CD.HiAuTr;π For i := CD.LoAuTr to CD.HiAuTr doπ With Titles[i] doπ beginπ L := LongInt((Tracks[i+1].Start shr 16) and $FF) * 60π + (Tracks[i+1].Start shr 8) and $FFπ - ( LongInt((Tracks[i].Start shr 16) and $FF) * 60π + (Tracks[i].Start shr 8) and $FF);π Title := '???';π RunMin := L div 60;π RunSec := l - RunMin*60;π Start := Red2Hsg(Tracks[i]);π endπ end;ππππend;ππFunction CD_Stop: Boolean;πbegin { CD StopAudio }π FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 5; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $85; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Stop := CD.Status and $8000 = 0;ππend;πππFunction CD_Resume:Boolean;πbegin { ResumeAudio}π CtlBlk[0] := 3; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $88; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π Asmπ mov ax, Seg @DATAπ mov es, axπ mov ax, DevDrvReqπ lea bx, CtlBlkπ Int 2fhπ end;π CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Resume := CD.Status and $8000 = 0;ππend;ππFunction CD_GetVol:Boolean;πbeginπ CtlBlk[0] := 4; { die Lautstaerke lesen }π CD_GetVol := CD_IOCtl(IoCtlRead, 8);π if ((R.Flags and FCARRY) = 0)π then Move(CtlBlk[1], CD.VolInfo, 8)π else FillChar( CD.VolInfo, 8, 0)πend;ππFunction CD_SetVol:Boolean;πbeginπ CtlBlk[0] := 3; { die Lautstaerke setzen }π CD_SetVol := CD_IOCtl( IoCtlWrite, 8);πend;ππFunction CD_HeadAdr: Boolean;πVar L:LongInt; S:String;πbeginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 1;π CtlBlk[1] := 1; { die KopfPosition im RED-Format }π CD_HeadAdr:= CD_IOCtl(IoCtlRead, 128);π if ((R.Flags and FCARRY) = 0)π then beginπ Move(CtlBlk[2], L, 4);π if CtlBlk[1] = 1 thenπ beginπ STR( CtlBlk[4]:2, S); CD_REDPos := S;π STR( CtlBlk[3]:2, S); CD_REDPos := CD_REDPos+ ':'+ S;π CD.Sector := LongInt(CtlBlk[4]) *4500 +π LongInt(CtlBlk[3]) *75 +π LongInt(CtlBlk[2])π - 150;π end elseπ beginπ CD.Sector := L;π STR(L:0,CD_HSGPos);π endππ endπ else FillChar( CD.Sector, 4, 0);πend;πππFunction CD_Position:Boolean;πVar l : LongInt;πbeginπ CtlBlk[0] := 12; { Audio-Infos }π CD_Position :=CD_IOCtl(IoCtlRead,10);π Move(CtlBlk[1], CD.CntAdr, 10);πend;πππProcedure CD_GetUAN;πbeginπ CtlBlk[0] := 14; { EAN-Nummer }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.Uctrl, 10);πend;πππFunction CD_MediaChanged:Boolean;πbeginπ CtlBlk[0] := 9; { Media-Change }π If CD_IOCtl(IoCtlRead, 1)π then Move(CtlBlk[1], CD.MedChg, 1 );π CD_MediaChanged:= CD.MedChg <> 1πend;ππProcedure CD_Info;πbeginππ { CD_Reset; }ππ If CD_HeadAdr then;ππ CtlBlk[0] := 6; { Device-parameter }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.DevPar, 4 );ππ CtlBlk[0] := 7; { Sector-Groesse }π If CD_IOCtl(IoCtlRead, 3) { & Modus }π then Move(CtlBlk[1], CD.RawMode, 3 );ππ CtlBlk[0] := 8; { Volume-Groesse }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.VolSize, 4 );ππ CtlBlk[0] := 12; { Audio-Infos }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.CntAdr, 10);ππ CtlBlk[0] := 11; { Track-Infos }π CtlBlk[1] := CtlBlk[2]; { aktueller... }π If CD_IOCtl(IoCtlRead, 6)π then Move(CtlBlk[1], CD.TrkNo, 6 );ππ CD_VtoC;ππend;ππ{========= minimale Initialisierung =============}πbeginπ CD_Avail := CD_Init;π if CD_Avail then CD_INFOπend. Norbertππ{π--- part 2, a Test -----π}πProgram CDROM_TEST;πUses Crt, cdrom, SbTest;πType a5 = Array[0..4] of Byte;πVar i:Byte;π L : LongInt;π ch : Char;π no,π len : Integer;ππbeginπ ClrScr;π WriteLn('CDROM-Unit TestProgram',#10);π With CD doπ if CD_Avail thenπ beginπ WriteLn('■ CD als Laufwerk ',DrvChar,': gefunden!');π Write ('■ Aktuelle CD: ');ππ Write('(UPN-CODE:');π For i := 1 to 7 do Write(Char( (Upn[i] shr 4) or $30),π Char((Upn[i] and $f) or $30));π WriteLn(#8')');π WriteLn('■ Audio-Tracks : ',loautr,'..',hiautr);π WriteLn(' Laufzeiten : ');π For i := CD.LoAuTr to CD.HiAuTr doπ With VtoC.Titles[i] doπ WriteLn(i,Title:10, RunMin:6,':',RunSec);π no := 1;π len := -1;ππ if CD_Stop thenπ if not CD_Play( no ,len)π then WriteLn('! Fehler-Status: ',STATUS and $F);ππ ch := ' ';π While ch <> #27 doπ beginπ While ch = ' ' doπ With CD doπ beginπ if CD_Position thenπ Write('Playing Track ',CTrk,' : ',CMin:2,':',CSek:2,' '#13);π Delay(1500);π if KeyPressedπ then ch := ReadKey;π end;π Case ch ofπ '+' : Inc(no);π '-' : Dec(no);π end;π if ch <> #27 then ch := ' ';π if no > cd.HiAUTr then Dec(no);π if no < cd.LoAuTr then Inc(no);π if CD_Stopπ then CD_Play(no, len);π end;π cd_stop;π clreol;π WriteLn(' CD stopped...');π endπ else WriteLn('Leider kein CD-ROM gefunden...');πend.ππ 2 05-28-9313:38ALL SWAG SUPPORT TEAM CHANGDRV.PAS IMPORT 30 { Author: Greg Estabrooks }πProgram DriveInf;πUsesπ Crt, (* ClrScr routine *)π Dos; (* Register Type, Intr() Routine *)πVarπ Regs :Registers; (* To hold register info For Intr() *)π CH :Char; (* To hold Drive to change to *)πππFunction GetDrive :Byte;π (* Routine to Determine the default drive *)πbeginπ Regs.AX := $1900; (* Function to determine drive *)π Intr($21,Regs); (* Call Dos int 21h *)π GetDrive := Regs.AL; (* Return Proper result *)π (* Returns 0 = A, 1 = B, 2 = C, ETC *)πend;ππProcedure ChangeDrive( Drive :Byte );π (* Routine to change default drive *)πbeginπ Regs.AH := $0E; (* Function to change Drives *)π Regs.DL := Drive; (* Drive to change to *)π Intr($21,Regs); (* Call Dos Int 21h *)πend;ππFunction NumDrives :Byte;π (* Routine to determine number of valid drives *)πVarπ CurDrive :Byte; (* Temporary storage For current drive*)πbeginπ CurDrive := GetDrive; (* Find out the current drive *)π Regs.AH := $0E; (* Function to change drives *)π Regs.DL := CurDrive; (* Change to current drive *)π Intr($21, Regs); (* Call Dos *)π NumDrives := Regs.AL; (* Return proper info to user *)πend;ππbeginπ ClrScr; (* Clear the screen *)π (* Write Current Drive to Screen *)π Writeln('Current Drive Is : ',CHR(GetDrive+65 ),':\');π Write('What Drive do you wish to change to ?[A..');π WriteLn(CHR(NumDrives + 64 ),']');π CH := ReadKey; (* Get Choice *)π CH := UpCase( CH ); (* Convert to uppercase *)π ChangeDrive( Ord( CH )-65 ); (* Change to chosen drive *)πend.π(**********************************************************************)πππ{ And here are the above in Inline Asm. I hope these help. }ππFunction GetDrive :Byte; Assembler;π { Routine to Determine the default drive }πAsmπ Mov AX,$1900 { Function to determine drive }π Int $21 { Call Dos int 21h }π { Returns 0 = A, 1 = B, 2 = C, ETC }πend;{GetDrive}ππProcedure ChangeDrive( Drive :Byte ); Assembler;π { Routine to change default drive }π { 0 = A, 1 = B, 2 = C, ETC }πAsmπ Mov AH,$0E { Function to change Drives }π Mov DL,Drive { Drive to change to }π Int $21 { Call Dos Int 21h }πend;{ChangeDrive}ππFunction NumDrives :Byte; Assembler;π { Routine to determine number of valid drives }πAsmπ Call GetDrive { Find out the current drive, Returns }π { Drive in AL }π Mov AH,$0E { Function to change drives }π Mov DL,AL { Change to current drive }π Int $21 { Call Dos }π { Number of drives is returns in AL }πend;{NumDrives}ππ 3 05-28-9313:38ALL SWAG SUPPORT TEAM DEFAULT.PAS IMPORT 9 *--* 03-31-93 - 21:49:00 *--*π/. Date: 03-31-93 (09:51) Number: 24032 of 24035π To: IOANNIS HADJIIOANNOU Refer#: 23844πFrom: LEE BARKER Read: NOπSubj: Current Drive Status: PUBLIC MESSAGEπConf: R-TP (552) Read Type: GENERAL (A) (+)ππ┌─┬─────────────── Ioannis Hadjiioannou ───────────────┬─╖π│o│ How can I find which drive is the default drive? │o║π╘═╧══════════════════════════════════════════════════════════╧═╝πWhile X may mark the spot, period marks/inhibits the drive.ππUses Dos;πbeginπ Writeln(fexpand('.'));πend.ππAs For getting the drive Label look up findfirst With anπattribute of "directory".π---π ■ Tags τ Us ■ Operator! Trace this call and tell me where I amπ * Suburban Software - Home of King of the Board(tm) - 708-636-6694π * PostLink(tm) v1.05 SUBSOFT (#715) : RelayNet(tm) Hubππ(61 min left), (H)elp, end of Message Command? 4 05-28-9313:38ALL SWAG SUPPORT TEAM DETCDRIV.PAS IMPORT 5 {│o│ How do I detect active drives in Pascal? My Program would │o║π│o│ crash if you Typed in a non-existent drive as either │o║π│o│ source or destination. │o║π}πUses Dos;πVar sr : SearchRec;πbeginπ findfirst('k:\*.*',AnyFile,sr);π if Doserror=0π then Writeln('It is there all right!')π else Writeln('Sorry, could not find it.');πend.ππ 5 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVE-ID.PAS IMPORT 25 {π Below is TP code to do drive-Type identification. I leave it as aπ research exercise For you to create code to differentiate betweenπ a RAM drive and fixed disk, if that's needed.ππ}π(********************************************************************)π Program DrvCount; { coded by Greg Vigneault }π Uses Crt,Dos; { For MsDos Function }π Var Drives :Byte; { count of logical drives }π Reg :Registers; { to access CPU Registers }π ThisDrive :Byte; { loop count }π DriveType :String[16]; { Type of drive found }π DataBuffer :Array [0..127] of Byte; { buffer For Dos i/o }π beginπ ClrScr; { remove screen clutter }π Reg.AH := $19; { get current disk code }π MsDos(Reg); { via Dos }π Reg.DL := Reg.AL; { returned drive code }π Reg.AH := $E; { select disk }π MsDos(Reg); { via Dos }π Drives := Reg.AL; { number of logical drives }ππ WriteLn('Number of logical drives: ', Drives );ππ Intr($11,Reg); { get system equipment flag }π if ( (Reg.AX and 1) <> 0 ) { any floppies installed? }π then WriteLn('(physical floppy drives: ',π (Reg.AX SHR 6) and 3, ')' ); { get bits 6&7 }ππ For ThisDrive := 1 to Drives do begin { scan all drives }π Reg.AX := $440D; { using generic I/O control }π Reg.CX := $860; { to get drive parameters }π Reg.BL := ThisDrive; { For this drive }π Reg.DX := ofs(DataBuffer); { Pointer to scratch buffer }π Reg.DS := Seg(DataBuffer); { in is DS:DX }π MsDos(Reg); { thank you, Dos }π Case ( DataBuffer[1] ) of { which Type it is... }π 0 : DriveType := '360 KB 5.25" FDD';π 1 : DriveType := '1.2 MB 5.25" FDD';π 2 : DriveType := '720 KB 3.5" FDD';π 3 : DriveType := 'SD 8"'; { a relic from CP/M roots }π 4 : DriveType := 'DD 8"'; { ditto }π 5 : DriveType := 'Fixed/RAM disk'; { HDD or RAM }π 6 : DriveType := 'Tape drive'; { a good investment }π 7 : DriveType := '1.44 MB 3.5" FDD' { or "other" drv }π else DriveType := '???'; { anything else }π end; { Case }π WriteLn(' - ', CHR(ThisDrive+64),': (', DriveType, ')' );π { further code could ID between RAM drive & HDD }π end; { For }π end. { Program }π(********************************************************************)π 6 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES1.PAS IMPORT 5 {πHere are some routines For Changing and detecting drives.π}ππUses Crt, Dos;πVarπ Regs :Registers;ππFunction GetDrive :Byte;πbeginπ Regs.AX := $1900;π Intr($21,Regs);π GetDrive := (Regs.AL + 1);π (* Returns 1 = A:, 2 = B:, 3 = C:, Etc *)πend;ππProcedure ChangeDrive(Drive :Byte);πbeginπ Regs.AH := $0E;π Regs.DL := Drive; (* Drive 1 = A:, 2 = B:, 3 = C: *)π Intr($21,Regs);πend;ππbeginπ ClrScr;π Writeln(' Current Drive : ',CHR( GetDrive+64 ));πend.π 7 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES2.PAS IMPORT 4 Program DriveID;πUsesπ Dos;πConstπ First : Boolean = True;πVarπ Count : Integer;πbeginπ Write('You have the following Drives: ');π For Count := 3 to 26 doπ if DiskSize(Count) > 0 thenπ beginπ if not First thenπ Write(', ');π First := False;π Write(UpCase(Chr(ord('a') - 1 + Count)),':')π end;π WriteLn;πend.π 8 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES3.PAS IMPORT 10 { JW│ How do I detect active drives in Pascal? My Program would crash if youπ │ Typed in a non-existent drive as either source or destination.ππHere's the method I use:π}πUsesπ Dos;ππVarπ Isthere : Boolean;ππFunction ChangeDrive( drv: Char ): Boolean;π(*πTakes drive letter as parameter, returns True if changeπsucceeded, False if change failed (invalid drive)π*)πVarπ Regs: Dos.Registers;π NewDrv: Byte;πbeginπ(* Calculate drive code For desired drive *)π NewDrv := orD( UpCase( drv ) ) - orD( 'A' ); (* A: = 0 *)ππ(* Change drive *)π Regs.DL := NewDrv;π Regs.AH := $0E; (* Function 0Eh: Select Disk *)π MSDos( Regs );ππ(* See if the change 'took' *)π Regs.AH := $19; (* Function 19h: Get current drive *)π MSDos( Regs );π ChangeDrive := (Regs.AL = NewDrv);πend; (* ChangeDrive *)ππbeginπ isthere := ChangeDrive('a');π Writeln ('a: ',isthere);π isthere := ChangeDrive('b');π Writeln ('b: ',isthere);π isthere := ChangeDrive('c');π Writeln ('c: ',isthere);π isthere := ChangeDrive('d');π Writeln ('d: ',isthere);π isthere := ChangeDrive('e');π Writeln ('e: ',isthere);πend.π 9 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES4.PAS IMPORT 35 {π> Does anyone know if there is a way For a Pascal Program to determineπ> whether a drive is a local hard drive, a network drive, a Dosπ> SUBSTituted drive, or a RAMDRIVE?ππHmm... I'm reading this one week after it got posted. and a month after theπoriginal question. I haven't read last week's messages, hope you hadn'tπrecieved to many answers about this now. But because you apparently hadn't gotπanything two weeks after asking, I thought you may want this, so here comes...ππThere is a service in Dos that identifies a given drive as local or remote.πThis service also tells you if the drive is SUBSTed. You can also get infoπabout whether it Uses removable media from another service. There is no way toπdetect a RAM-drive, as Far as I know, and I've got the facts from Microsoft'sπown MSJ! The Dos 5 DosSHELL simple checks the volume identifier. if it'sπ'MS-RAMDRIVE', 'RDV' or 'VDISK', the drive is ASSUMED to be a RAM-disk. Butπit's, again according to Microsoft Systems Journal, impossible to foolproofπcheck if a drive is a logical RAM-drive. A design flaw in Dos.ππHowever, I will show a few lines of TP-code For checking if a drive is remoteπor local, and SUBSTed or not. I use the TP 5.5 (and older) method of Intr-callsπFor simulating Asm, of course if could be written clearer With TP6'sπAsm-keyWord. The code consists of the actual Function and a test stub, cut theπstub when you have looked at it. Code Compiles and runs fine on my system; Iπcouldn't test if it work With remote drives, but it should. I've used similarπcode that worked With that too, so...ππ}πProgram TestDrv;ππ{ --- A very short test-Program For Dos-IOCTL, Jacob Stedman 930223 --- }ππUsesπ Dos;ππFunction IsDriveValid(cDrive: Char; Var bLocal, bSUBST: Boolean): Boolean;π{π Parameters: cDrive is the drive letter, 'A' to 'Z', that's aboutπ to be checked. if not in this range, the Function will return False.ππ Returns: Function returns True if the given drive is valid, elseπ False (!). bLocal is set if drive is local, bSUBST if drive isπ substituted. if Function returns False, the Booleans are undefined.π}πVarπ rCPU: Dos.Registers;πbeginπ { --- Call Dos and process returns --- }π if not (UpCase(cDrive) in ['A'..'Z']) then { --- letter OK?--- }π IsDriveValid := Falseπ elseπ beginπ { --- Valid letter, set up For the Dos-call --- }π rCPU.bx := ord(UpCase(cDrive))-ord('A')+1;π rCPU.ax := $4409;π { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }π Intr($21, rCPU);π if (rCPU.ax and FCarry) = FCarry thenπ IsDriveValid := Falseπ elseπ begin { --- drive is valid, check status --- }π IsDriveValid := True;π bLocal := ((rCPU.dx and $1000) = $0000);π if bLocal thenπ bSUBST := ((rCPU.dx and $8000) = $8000)π elseπ bSUBST := False;π end;π end;πend;ππVarπ cCurChar : Char; { loop counter, drive }π bLocal,π bSUBST : Boolean; { drive local/remote?; SUBSTed or not? }ππbeginπ { --- Write header --- }π Writeln; Writeln(' VALID DRIVES:'); Writeln;π { --- Loop from 'A' to 'Z', For each iteration check a drive --- }π For cCurChar := 'A' to 'Z' doπ if IsDriveValid(cCurChar, bLocal, bSUBST) thenπ beginπ Write(cCurChar, ': ');π if bLocal thenπ Write(' local ')π elseπ Write(' remote');π if bSUBST thenπ Write(' SUBSTed ')π elseπ Write(' not SUBSTed');π Writeln;π end;π { --- Write footer --- }π Writeln;πend.ππ{πThe code is simple. It calls the Dos IOCTL-service #09h, 'Is Drive Remote',πwith the drive number (1-A:, 2-B:, ...) in the bl-register. if the drive isn'tπvalid, the carry flag is set. if valid, carry is clear, and the dx-registerπcontains bit-fields you're interested in. Bit 12 is 1 if remote, 0 if local. ifπlocal, bit 15 is 1 if the drive is a substitution. In TP, you get access toπthem, in this Case, by using the 'and'-binary operator.ππI guess you're interested in making a Filemanager or a report util or thatπlike. then, you're maybe interested to get source For detection of CD-ROMπdrives and floppys? if so, post me a new msg. I always like to recieve newπmail... I didn't include this here, this msg is too long without that extraπcode. Feel free to Write if you get any problems.π} 10 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES5.PAS IMPORT 16 {πAuthor : MARCO MILTENBURGππHere's an overview of INT13h, Function 8 :ππName : Get drive parametersππInput : AH = 08hπ DL = <drive> 00h - 7Fh : Floppy diskπ 80h - FFh : HarddiskππOutput: if succesfullπ -------------π Carry is clearedπ BL = <driveType> 01 : 360 KBytes, 40 tracks, 5.25 Inchπ 02 : 1,2 MBytes, 80 tracks, 5.25 Inchπ 03 : 720 KBytes, 80 tracks, 3.5 Inchπ 04 : 1,44 MBytes, 80 tracks, 3,5 Inchπ CH = Lower 8 bits of maximum cylindernumberπ CL = bits 6-7 : Highest 2 bits of maximum cylindernumberπ bits 0-5 : Maximum sectornumberπ DH = Maximum headnumberπ DL = Number of connected drivesπ ES:DI = Pointer to disk drive parameter tableππ if failedπ ---------π Carry is setπ AH = errorstatusππAs you can see, you must do more to get the cylindernumber. Here's a littleπpascal code :π}ππUsesπ Dos;ππConstπ DriveTypes : Array[0..4] of String[18] = ('Harddisk ',π '360 kB - 5.25 Inch',π '1.2 MB - 5.25 Inch',π '720 kB - 3.5 Inch ',π '1.44 MB - 3.5 Inch');πVarπ Regs : Registers;πbeginπ Regs.AH := $08;π Regs.DL := $80;π Intr($13, Regs);ππ WriteLn ('DriveType : ', DriveTypes[Regs.BL]);π WriteLn ('Cylinders : ', 256 * (Regs.CL SHR 6) + Regs.CH + 1);π WriteLn ('Sectors : ', Regs.CL and $3F);π WriteLn ('Heads : ', Regs.DH + 1);ππend.π{πThis will give you the right information from your diskdrives. I noticed thatπmy harddisks will always be reported as driveType 0 (zero). I don't know forπsure if that is documented, but it seems to be logical ;-).π} 11 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES6.PAS IMPORT 23 {πAuthor : GAYLE DAVISππ> It will check For example, drive A:, and if there is no disk in theπ>drive it will return False, if it is ready it will return True..ππThere is a problem that you will have to deal With here from the beginning.πFirst of all Dos can't easily tell if the problem is that you drive door isπopen, say in drive 'A', or if the disk is unformatted or unreadable. Hereπis some code that I use to solve the problem using INT25. do not TRY THISπON A HARD DRIVE.π}πUsesπ Dos;ππFunction DisketteDrives : Integer;πVarπ Regs : Registers;πbeginπ FILLChar (Regs, SIZEOF (Regs), #0);π INTR ($11, Regs);π if Regs.AX and $0001 = 0 thenπ DisketteDrives := 0π elseπ DisketteDrives := ( (Regs.AX SHL 8) SHR 14) + 1;πend;ππFunction IsDriveReady (DriveSpec : Char) : Boolean; {A,B,etc}πVarπ result : Word;π Drive,π number,π logical : Word;π buf : Array [1..512] of Byte;π Regs : Registers;πbeginπ IsDriveReady := True; { Assume True to start }π Drive := ORD (UPCASE (DriveSpec) ) - 65; { 0=a, 1=b, etc }ππ if Drive > DisketteDrives thenπ Exit; { do not CHECK HARD DRIVES }ππ number := 1;π logical := 1;ππ Inline (π $55 / { PUSH BP ; Interrupt 25 trashes all}π $1E / { PUSH DS ; Store DS }π $33 / $C0 / { xor AX,AX ; set AX to zero }π $89 / $86 / result / { MOV Result, AX ; Move AX to Result }π $8A / $86 / Drive / { MOV AL, Drive ; Move Drive to AL }π $8B / $8E / number / { MOV CX, Number ; Move Number to CX }π $8B / $96 / logical / { MOV DX, Logical; Move Logical to DX }π $C5 / $9e / buf / { LDS BX, Buf ; Move Buf to DS:BX }π $CD / $25 / { INT 25h ; Call interrupt $25 }π $5B / { POP BX ; Remove the flags valu fr}π $1F / { POP DS ; Restore DS }π $5D / { POP BP ; Restore BP }π $73 / $04 / { JNB Done ; Jump ... }π $89 / $86 / result); { MOV Result, AX ; move error code to AX }π { Done: }ππ IsDriveReady := (result = 0);πend;ππ(*πAlso, you could change the ISDRIVEREADY Function if you wanted to find outπWHY the drive isn't ready by checking the LO(result). Like this :ππ if result <> 0 thenπ beginπ Case LO (result) OFπ 0 : FloppyState := WritePROTECT; { should not ever happen }π 1..4 : FloppyState := DOOROPEN;π 5..12 : FloppyState := NOFORMAT;π elseπ FloppyState := DOOROPEN;π endπ endπ elseπ FloppyState := DRIVEREADY;π*)π 12 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVNAME.PAS IMPORT 9 {πBO BendTSENππ> There's already a methode For finding all available drives withoutπ> accessing them - I'd like to have one to get the volume Labels of theπ> harddisks, SUBST- and network-drives without waiting seconds While theπ> Program accesses all the 20 drives available in my system ... ;-)ππTry this, it will show any SUBST drives, if a \\ first in the name is returnedπyou will have a network server name following.π}πUsesπ Dos;ππFunction ResolvePath(Var s : String) : Boolean;πVarπ r : Registers;π x : Byte;πbeginπ ResolvePath := False;π s := s + #0;π r.ds := Seg(S);π r.si := Ofs(S) + 1;π r.es := Seg(S);π r.di := Ofs(S) + 1;π r.ah := $60;π Intr($21, R);π If r.flags and 1 = 1 Thenπ Exit; { if ZF set then error }π ResolvePath := True;π x := 0;π While (s[x + 1] <> #0) And (x < 128) Doπ Inc(x);π s[0] := Chr(x);πend;ππVarπ DriveName : String;ππbeginπ DriveName := 'C';π Writeln(ResolvePath(DriveName));π Writeln(DriveName);πend.π 13 05-28-9313:38ALL SWAG SUPPORT TEAM EXIST-DD.PAS IMPORT 45 {π»Hey.. do you know anything about checking For the existance of a diskπ»drive without actually needing a disk to be in the drive? (i.e aπ»floppy?)ππTry reading the floppy and then test the error code. Heck, you can get allπthe info you would ever like to have about that drive. I went diggingπthrough my Files and found this.π}πUsesπ Dos;ππTypeπ bootrecptr = ^bootRecord;π bootRecord = Recordπ nj : Array[0..2] of Byte; {offset 0 Near jump code }π oem : Array[0..7] of Byte; { 3 OEM name and ver }π Bytesec : Word; { 11 Bytes/Sector }π sectclus : Byte; { 13 Sectors/cluster }π ressect : Word; { 14 Reserved sectors }π fattables: Byte; { 16 FAT tables }π direntrys: Word; { 17 Directory entries}π logsec : Word; { 19 Logical sectors }π MDS : Byte; { 21 Media descriptor }π FatSects : Word; { 22 FAT sectors }π Secstrak : Word; { 24 Sectors/track }π NumHeads : Word; { 26 Number of heads }π HidnSecs : Word; { 28 Hidden sectors }π bootcode : Array[0..415] of Byte; { 30 boot code }π partcode : Array[0..15] of Byte; { 446 partition info }π bootcode2: Array[0..49] of Byte; { 462 rest of boot code}π end;ππVarπ boot : bootRecord; { the boot Record Variable }ππ{$L DiskInfo}π { an Object File that allows For reading Absolute disk sectors }π{$F+}πFunction diskread(drive: Byte; starting_sector: LongInt;π number_of_sectors: Word; Var buffer): Word; external;π { - read a disk sector Absolutely }π{$F-}ππProcedure bootlook(Drive : Char);πVarπ ReadResult : Word;π I : Integer;πbeginπ { Get diskette info }π ReadResult := DiskRead(ord(Drive)-ord('A'),0,1,boot);π if ReadResult <> 0 thenπ beginπ { Error code here }π endπ elseπ beginπ { read went ok, do something }π end;πend; { Procedure bootlook }π{ππ--------------------- CUT HERE -----------------------π; This part goes through Turbo Assemblerπ;π; Diskread Procedureπ;ππ.286Pπ.8087ππCODE segment Byte Publicππ; Conditional jumps are all coded With the SHorT qualifier inπ; order to minimize the size of the .OBJ File output of Turboπ; Assembler.π;--------------------------------------------------------------------π Assume cs:CODE, ds:DATA, es:nothingπ public DISKREADππDISKREAD proc Farπ; On entry:π; BPπ; SP => Near return addressπ; offset of disk bufferπ; segment " " "π; number of sectors to readπ; starting logical sector numberπ; drive number (0=A, 1=B, etc.)π;π; On Exit:π;π; AX = Function resultπ; 00 - Function successfulπ; 01..FF - Dos inT 25H error resultπ drive equ [bp + 16]π starting_sector equ [bp + 12]π number_of_sectors equ [bp + 10]π buffer equ [bp + 6]ππ push bpπ mov bp,spπ mov ax,3000h ;get Dos versionπ int 21hπ cmp al,4 ;Dos 4?π jge read4 ;We have 4 or newer, so use Extendedπ push es ;save regsπ push dsπ mov dl,drive ;get drive number (0=A,1=B,etc)π mov ah,32h ;get driver parameter blockπ int 21hπ push ds ;move ds to esπ pop esπ pop ds ;restore original dsπ les bx,[es:bx + 12h] ;point ES:BX to device driverπ mov ax,[es:bx + 4] ;get device attributesπ pop esπ test ax,2 ;check if bit 1 setπ jz read3 ;wasn't, so use old methodππread4:π mov al,driveπ mov bx,starting_sector ;copy info into parameter blockπ mov extd_starting_sector_lo,bxπ mov bx,starting_sector + 2π mov extd_starting_sector_hi,bxπ mov bx,number_of_sectorsπ mov extd_number_of_sectors,bxπ les bx,buffer ;get seg:ofs of buffer in ES:BXπ mov extd_bufofs,bx ;put into blockπ mov extd_bufseg,esπ mov bx,offset Dos4_block ;DS:BX points to blockπ mov cx,-1 ;-1 means Extended readπ push ds ;save DS (not Really needed, but letsπ ;me share code With Dos 3 read.)π jmp short readitπread3: mov al,driveπ mov dx,starting_sectorπ mov cx,number_of_sectorsπ push dsπ lds bx,buffer ;get seg:ofs of buffer in DS:BXπreadit: int 25Hπ inc sp ; fix broken stackπ inc spπ pop dsπ jc short diskread_01π xor ax,axπdiskread_01:π pop bpπ ret 10πDISKREAD endpπ} 14 05-28-9313:38ALL SWAG SUPPORT TEAM EXIST-HD.PAS IMPORT 7 Program CheckForHDExistence;πUsesπ Dos;ππFunction checkdsk(drive:Char):Boolean;πbeginπ checkdsk:=disksize(Byte(upcase(drive))-64)>0;πend;ππbeginπ { Doesn't work For Floppies unless a disk is present }π if checkdsk('A') then Writeln('Valid! A')π else Writeln('Not Valid A');π if checkdsk('B') then Writeln('Valid! B')π else Writeln('Not Valid B');π if checkdsk('C') then Writeln('Valid! C')π else Writeln('Not Valid C');π if checkdsk('D') then Writeln('Valid! D')π else Writeln('Not Valid D');π if checkdsk('E') then Writeln('Valid! E')π else Writeln('Not Valid E');π if checkdsk('F') then Writeln('Valid! F')π else Writeln('Not Valid F');πend.ππ 15 05-28-9313:38ALL SWAG SUPPORT TEAM LASTDRIV.PAS IMPORT 7 Function LastDrive: Char; Assembler;πAsmπ mov ah, 19hπ int 21hπ push ax { save default drive }π mov ah, 0Ehπ mov dl, 19hπ int 21hπ mov cl, alπ dec cxπ@@CheckDrive:π mov ah, 0Eh { check if drive valid }π mov dl, clπ int 21hπ mov ah, 19hπ int 21hπ cmp cl, alπ je @@Validπ dec cl { check next lovest drive number }π jmp @@CheckDriveπ@@Valid:π pop axπ mov dl, alπ mov ah, 0Ehπ int 21h { restore default drive }π mov al, clπ add al, 'A'πend;πππ(*πLastDrive will return letter of the last valid drive. To checkπif the drive letter entered is valid:ππif Upcase(DriveLetter) <= LastDriveπ then {valid drive}π else {bad drive};π*) 16 05-28-9313:38ALL SWAG SUPPORT TEAM SERIALNM.PAS IMPORT 14 {π>How can [a disk serial number] be read from TP? Can it be changed other thanπ>by re-Formatting? I can't find any reference to serial numberπ>in the Dos 5.0 users guide except a passing one in the sectionπ>on the ForMAT command.π}πUses Dos;πVar regs : Registers;π LabelInfo : Recordπ InfoLevel : Word; {Always 0}π SerialNum : LongInt;π VolumeLabel : Array [1..11] of Char;π FileSystemType : Array [1..8] of Char;π end;πbeginππ if lo(DosVersion)<4 thenπ beginπ Writeln ('Only works With Dos 4.0 or higher');π Exit;π end;ππ LabelInfo.InfoLevel := 0; {Set Info level (0 is the only legal value)}π With regs doπ beginπ ax := $6900; {Function $69 With 0 in AL gets, With 1 in AL sets}π bl := 0; {Drive, 0 For default, 1 For A:, 2 For B:, ...}π ds := seg(LabelInfo); {DS:DX points at structure}π dx := ofs(LabelInfo);π es := 0; {Do not have garbage in segment Registers}π flags := 0; { or in flags}ππ MsDos(Regs);ππ if Odd(flags) then {Carry set if error}π beginπ Case AX ofπ 1: Writeln ('Illegal attempt to get Label from network drv');π 5: Writeln ('No Extended BPB on disk (Format old)');π else Writeln ('Unknown error');π end;π end;π end;ππ{On return, fills SerialNum, VolumeLabel, and FileSystemType fields.π places 'FAT12 ' or 'FAT16 ' in FileSystemType, For 12- or 16-bit FATπentries. With AL=1, will use info you store in LabelInfo to set disk'sπextended BPB}π 17 05-28-9313:38ALL SWAG SUPPORT TEAM TRUENAME.PAS IMPORT 6 Program TrueName; uses DOS;ππ function RealName(FakeName:String):String;π Var Temp:String;π beginπ FakeName := FakeName + #0; { ASCIIZ }π With Regs doπ beginπ AH := $60;π DS := Seg(FakeName); SI := Ofs(FakeName[1]);π ES := Seg(Temp); DI := OfS(Temp[1]);π INTR($21,Regs);π DOSERROR := AX * ((Flags And FCarry) shr 7);π Temp[0] := #255;π Temp[0] := CHAR(POS(#0,Temp)-1);π end;π If DosError <> 0 then Temp := '';π RealName := Temp;π end;ππbegin writeln( RealName( Paramstr(1) ) end.π 18 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-ID.PAS IMPORT 20 {π In the thread concerning copy protection (in which I have noπ interest) the serial number of a disk was mentioned.π How can this be read from TP? Can it be changed other thanπ by re-Formatting? I can't find any reference to serial numberπ in the Dos 5.0 users guide except a passing one in the sectionπ on the ForMAT command.ππReading the volume id number is no problem:ππreads volume id number -- not sophisticated enough toπdetermine whether disk was Formatted With a Dos versionπnew enough to assign volume id }ππUses Dos;ππFunction Byte2HexSt(b : Byte) : String;πConstπ hexChars: Array [0..$F] of Char =π '0123456789ABCDEF';πbeginπ Byte2HexSt := hexChars[b shr 4] + hexChars[b and $F];πend;ππProcedure ResetDisk(DriveNo : Byte);πVarπ reg : Registers;πbeginπ reg.ah := 0; { bios Function reset drive system }π reg.dl := DriveNo;π intr($13,reg);πend;ππFunction VolIDSt(DriveCh : Char) : String;π{ returns Volume ID number as a String of hex digits }πVarπ reg : Registers;π try : Integer;π buff : Array[0..1023] of Byte;πbeginπ DriveCh := upCase(DriveCh);π try := 0;π Repeatπ reg.ax := $0201; { ah = bios Function read disk sector }π { al = read 1 sector }π reg.cx := $0001; { ch = cylinder number }π { cl = sector number }π reg.dh := 0; { head number }π reg.dl := ord(DriveCh) - 65; { drive number }π reg.es := seg(buff);π reg.bx := ofs(buff);π intr($13,reg);π inc(try);π if reg.flags and FCarry <> 0 then ResetDisk(reg.dl);π Until ((reg.flags and FCarry) = 0) or (try = 3);π if reg.flags and FCarry <> 0π then VolIDSt := 'Error attempting to read volume ID number'π else VolIDSt := Byte2HexSt(buff[$2A]) +π Byte2HexSt(buff[$29]) + '-' +π Byte2HexSt(buff[$28]) +π Byte2HexSt(buff[$27]);πend;ππ{πCan the volume id number be changed? You bet.ππAlthough it is True that DISKCOPY will not copy the volume idπnumber from the original disk, it's still a pretty weak basis For aπcopy protection scheme. I consider myself a pretty unsophisticatedπProgrammer, but it only took me a few minutes of fooling around toπfigure out where the volume id number is on the disk. then all youπhave to do is grab an interrupt reference and quickly Type up someπcode to read and Write to the right spot on the disk.π}π 19 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-SER1.PAS IMPORT 18 {π This Turbo Pascal code will read the serial number and volumeπ from disks that have been Formatted under Dos 4.0 and higher ...π}π(*-------------------------------------------------------------------*)πProgram VolSN; { reads disk serial number & volume Label (Dos 4.0+) }πUses Dos;πType MediaID = Recordπ InfoLevel : Word;π SerialN : LongInt;π VLabel : Array [0..10] of Char;π SysName : Array [0..7] of Char;π end;ππVar IDbuffer : MediaID;π SerialNumber : LongInt;π VolumeLabel : String[12];π Reg : Registers;π loopc : Byte;πbeginπ WriteLn( #10, 'VolStat 0.00 Greg Vigneault', #10 );ππ Reg.AH := $30; { Function to get Dos version number }π MsDos( Reg ); { via MS-Dos }π if ( Reg.AL < 4 ) or ( Reg.AL = 10 )π then begin { must be Dos 4.0 or above (& not OS/2?) }π WriteLn( 'Dos version error',#7 );π Halt(1) { abort Program }π end;ππ Reg.AX := $6900; { Dos Function }π Reg.BL := 0; { Drive (0=current,1=A,2=B,etc)}π Reg.DS := Seg( IDbuffer ); { place to return data }π Reg.DX := ofs( IDbuffer );π MsDos( Reg ); { call Dos }π { there'll be an error if disk doesn't have a serial # ... }π if ( Reg.FLAGS and 1 ) <> 0 { carry flag set? }π then beginπ WriteLn( 'Dos error getting Media ID',#7 );π Halt(2);π end;ππ SerialNumber := IDbuffer.SerialN; { get serial number }ππ WriteLn( 'Disk serial number: ', SerialNumber );ππ VolumeLabel := '';π loopc := 0;π While ( IDbuffer.VLabel[ loopc ] <> ' ' )π do beginπ VolumeLabel[ loopc+1 ] := IDbuffer.VLabel[ loopc ];π inC( loopc );π end;π VolumeLabel[0] := CHR( loopc ); { set TP String length }π if ( loopc <> 0 ) thenπ WriteLn( 'Disk volume Label : ', VolumeLabel );πend.π 20 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-SER2.PAS IMPORT 17 {π>Who can give me the source code in TP 6.0 which reads a HardDisks Volumeπ>Serial Number ?ππStarting With Dos 4 this inFormation can be GET/SET using inT 21h func 69hπ Entry AH =69hπ Al = 00h Get Serial number and Labelπ Al = 01h Set Serial numberπ BL = drive number 0=default, 1=A: .....)π DS:DX Pointer to a 24 Bytes Buffer (see below)π Returnπ Cf set on errorπ AX = error code (same as Int 21h AH = 59 )π CF Clear if Okπ if AL was 0 then Buffer is filled withπ offset size Contents:π 0 Word 0π 2 DWord the disk Serial numberπ 6 11 Bytes= volume Label or "NO NAME"π 16 8 Bytes = 'FAT12' or 'FAT16'ππ The buffer is actually a copy of ByteS $27 to $3D of the Sector 0 of the diskπ So With previous versions of Dos one should be able to do an Absolute readπ of sector 0 from the disk and extract the Info from a buffer. I did not dareπ doing it....ππ Last Thought: With Dos earlier than 4 , there was no disk serial numberπ so what the point looking For one .... !!!!π Although this info can be used to set one ???π (not by me... I need too badly my hard disk toπ experiment With Int 13h ..... )ππ Here is a Program that Get these Infos...π I did not dare trying the Set Function (AL=1...) see above...π}πProgram GetSerial;πUsesπ Dos;πVarπ Buffer : Array[0..23] of Byte;π R : Registers;π Serial : LongInt;π VLabel : String[11];π Fat : String[8];πbeginπ R.AH := $69;π R.AL := 0;π R.BL := 3; { C: Drive }π R.DS := Seg(Buffer);π R.DX := ofs(Buffer);π Intr($21,R);π if (R.Flags and Fcarry = 0) thenπ beginπ Move(Buffer[2], Serial, Sizeof(LongInt));π Move(Buffer[6], VLabel[1], 11);π VLabel[0] := Char(11);π Move(Buffer[16], Fat[1], 8);π Fat[0] := Char(8);π end;π Writeln(VLabel);π Writeln(Fat);π readln;πend.π 21 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL1.PAS IMPORT 30 > I need a way to find the volume Label of a drive. Any suggestions orπ> source code?ππ{$S-,R-,V-,I-,N-,B-,F-}ππUnit Volume;ππInterfaceππUsesπ Dos;ππTypeππ Drive = Byte;π VolumeName = String [11];ππ VolFCB = Recordπ FCB_Flag : Byte;π Reserved : Array [1..5] of Byte;π FileAttr : Byte;π Drive_ID : Byte;π FileName : Array [1..8] of Byte;π File_Ext : Array [1..3] of Byte;π Unused_A : Array [1..5] of Byte;π File_New : Array [1..8] of Byte;π fExt_New : Array [1..3] of Byte;π Unused_B : Array [1..9] of Byteπ end;ππFunction DelVol (D : Byte) : Boolean;πFunction AddVol (D : Byte; V : VolumeName) : Boolean;πFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πFunction GetVol (D : Byte) : VolumeName;ππImplementationππProcedure Pad_Name (Var V : VolumeName);πbeginπ While LENGTH (V) <> 11 DOπ V := V + ' 'πend;ππFunction Fix_Ext_Sym (Var V : VolumeName) : Byte;πVarπ I : Byte;πbeginπ I := POS ('.', V);π if I > 0 thenπ DELETE (V, I, 1);π Fix_Ext_Sym := Iπend;ππFunction Extract_Name (S : SearchRec) : VolumeName;πVarπ H, I : Byte;πbeginπ I := Fix_Ext_Sym (S.Name);π if (I > 0) and (I < 9) thenπ For H := 1 to (9 - I) DOπ INSERT (' ', S.Name, I);π Extract_Name := S.Nameπend;ππProcedure Fix_Name (Var V : VolumeName);πVarπ I : Byte;πbeginπ Pad_Name (V);π For I := 1 to 11π do V [I] := UPCASE (V [I])πend;ππFunction Valid_Drive_Num (D : Byte) : Boolean;πbeginπ Valid_Drive_Num := (D >= 1) and (D <= 26)πend;ππFunction Find_Vol (D : Byte; Var S : SearchRec) : Boolean;πbeginπ FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);π Find_Vol := DosError = 0πend;ππProcedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.File_New [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.fExt_New [I] := ORD (V [I + 8])πend;ππProcedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.FileName [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.File_Ext [I] := ORD (V [I + 8])πend;ππFunction Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;πVarπ Regs : Registers;πbeginπ FCB.Drive_ID := D;π FCB.FCB_Flag := $FF;π FCB.FileAttr := $08;π Regs.DS := SEG (FCB);π Regs.DX := OFS (FCB);π Regs.AX := Fnxn;π MSDos (Regs);π Vol_Int21 := Regs.AL = 0πend;ππFunction DelVol (D : Byte) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π V : VolumeName;πbeginπ DelVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π DelVol := Vol_Int21 ($1300, D, FCB)π endπ endπend;ππFunction AddVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;πbeginπ AddVol := False;π if Valid_Drive_Num (D) thenπ beginπ if not Find_Vol (D, sRec) thenπ beginπ Fix_Name (V);π Fix_FCB_FileName (V, FCB);π AddVol := Vol_Int21 ($1600, D, FCB)π endπ endπend;ππFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π x : Byte;πbeginπ ChgVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ x := Fix_Ext_Sym (V);π Fix_Name (V);π Fix_FCB_NewFile (V, FCB);π V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π ChgVol := Vol_Int21 ($1700, D, FCB)π endπ endπend;ππFunction GetVol (D : Byte) : VolumeName;πVarπ sRec : SearchRec;πbeginπ GetVol := '';π if Valid_Drive_Num (D) thenπ if Find_Vol (D, sRec) thenπ GetVol := Extract_Name (sRec)πend;ππend.π 22 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL2.PAS IMPORT 35 {πCould somebody help me out here? I'm trying to Write aπProgram that reads the File names and their attributes fromπdisk/drive.ππUnit volLabel;ππ Type String11 = String[11];π Function GetCurrentVolumeLabel : String11;π Procedure DelVolumeLabel(CurrentVolumeLabel:String11);π Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);π ( to change a volume Label: delete old, then Write new )π}ππ(* Implementation *)ππUsesπ Dos;ππVarπ oldir : String; { only For test Program }ππTypeπ ExtendedFCBType = Recordπ ExtendedFCBflag : Byte;π Reserved1 : Array[1..5] of Byte;π Attr : Byte;π DriveID : Byte;π FileName : Array[1..8] of Char;π FileExt : Array[1..3] of Char;π CurrentBlockNum : Word;π RecordSize : Word;π FileSize : LongInt;π PackedDate : Word;π PackedTime : Word;π Reserved2 : Array[1..8] of Byte;π CurrentRecNum : Byte;π RandomRecNum : LongInt;π end;ππType String11 = String[11];πFunction GetCurrentVolumeLabel : String11;πVarπ CurrentDrive: String;π VolumeLabel : SearchRec; { defined in the Dos Unit }π i : Word;πbegin { 12345678901 }π GetCurrentVolumeLabel:= 'no Label ';π getdir(0,CurrentDrive); {in Dos Unit }π CurrentDrive:= copy(CurrentDrive,1,3) + '*.*';π {get Volume Label in A: drive}π findfirst(CurrentDrive,VolumeID,VolumeLabel);π if Doserror=0 thenπ With VolumeLabel doπ beginπ {remove period}π delete(VolumeLabel.name,pos('.',VolumeLabel.name),1);π { pad to 11 Chars }π For i:= length(name) to 11 do name:= name + ' ';π GetCurrentVolumeLabel:= name;π end; { With VolumeLabel}πend; {of GetCurrentVolumeLabel }ππProcedure DelVolumeLabel(CurrentVolumeLabel:String11);π{delete volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8); {you have to put these in}π move(CurrentVolumeLabel[9],FileExt ,3); {For some silly reason }π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $13; {Dos 1.0 delete File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label deleted.')π else Writeln('Failure -- volume Label not deleted.');πend; { of DelVolumeLabel }ππProcedure WriteVolumeLabel(CurrentVolumeLabel:String11);π{create volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8);π move(CurrentVolumeLabel[9],FileExt ,3);π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $16; {Dos 1.0 create File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label written.')π else Writeln('Failure -- volume Label not written.');πend; { of WriteVolumeLabel }ππbegin { test Program }π getdir(0,oldir); { save current directory }π chdir('a:'); { play With diskette in A: }π Writeln('Old volume Label: ',GetCurrentVolumeLabel);π DelVolumeLabel(GetCurrentVolumeLabel);π WriteVolumeLabel('10987654321');π Writeln('New volume Label: ',GetCurrentVolumeLabel);π chdir(oldir); { go back to original directory }πend. { test program }π 23 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL3.PAS IMPORT 17 {π>I am having difficulty changing a disk volume Label using Turbo Pascal.π>Does anyone know how to acComplish this?π}πUsesπ Dos;ππType fcbType = Recordπ drive : Byte;π name : Array[1..8] of Char;π ext : Array[1..3] of Char;π fpos : Word;π recsize : Word;π fsize : LongInt;π fdate : Word;π ftime : Word;π reserv : Array[1..8] of Byte;π currec : Byte;π relrec : LongInt;π end;π extfcb = Recordπ flag : Byte; { must be $ff! }π reserv : Array[1..5] of Byte;π attrib : Byte;π fcb : fcbType;π end;πππFunction GetVolLabel(drive:Char):String;πVar sr : SearchRec;πbeginπ findfirst(drive+':\*.*',VolumeID,sr);π if Doserror=0 then GetVolLabel:=sr.nameπ else GetVolLabel:='';πend;πππProcedure setfcbname(Var fcb:fcbType; name:String);πVar p : Byte;πbeginπ p:=pos('.',name);π if p=0 then beginπ p:=length(name)+1;π name:=name+'.';π end;π fillChar(fcb.name,11,' ');π move(name[1],fcb.name,p-1);π move(name[p+1],fcb.ext,length(name)-p);πend;πππProcedure SetVolLabel(drive:Char; vLabel:String);πVar fcb : extfcb;π vl : PathStr;π regs : Registers;π f : File;πbeginπ vl:=GetVolLabel(drive);π fcb.flag:=$ff;π fcb.attrib:=VolumeID;π if vl<>'' then beginπ setfcbname(fcb.fcb,vl);π fcb.fcb.drive:=ord(UpCase(drive))-64;π regs.ah:=$13; { Delete File }π regs.ds:=seg(fcb);π regs.dx:=ofs(fcb);π msDos(regs);π end;π if vLabel<>'' then beginπ fcb.fcb.drive:=ord(UpCase(drive))-64;π setfcbname(fcb.fcb,vLabel);π With regs do beginπ ah:=$16; { Create File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π ah:=$10; { Close File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π end;π end;πend;π
